home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS12.ADF / AmigaBBS / mail (.txt) < prev    next >
AmigaBASIC Source Code  |  1986-08-05  |  12KB  |  297 lines
  1. Main:
  2. GOSUB Mail
  3. CHAIN "df0:Menus",10,ALL
  4.  
  5. Modem:
  6. IF rings=0 THEN OtherModem
  7. x=FRE(0)
  8. FOR j= 1 TO LEN(a$):p$=MID$(a$,j,1)
  9. PRINT p$;:PRINT#1,p$;:NEXT j
  10. a$="":p$="":RETURN
  11.  
  12. OtherModem:
  13. x=FRE(0)
  14. FOR j= 1 TO LEN(a$):p$=MID$(a$,j,1)
  15. PRINT p$;:NEXT j
  16. a$="":p$="":RETURN
  17.  
  18. Answers:
  19. telly=0:t$="":t=0:i$="":ch$="":alter=0:IF rings=0 THEN SomeAnswers
  20. WHILE 1 AND alter<1
  21.   WHILE LOC(1)<>0
  22.     ch$=INPUT$(1,1)
  23.     equivs=ASC(ch$) AND 127:IF equivs<>1 THEN ch$=CHR$(equivs)
  24.     i$=i$+ch$:equivs=0
  25.     telly=telly+1:IF telly=78 THEN ch$=r$
  26.     IF ch$=CHR$(8) AND LEN(i$)>=2 THEN i$=LEFT$(i$,LEN(i$)-2):telly=telly-1
  27.     IF ch$=CHR$(10) OR ch$=CHR$(13) OR ch$=r$ THEN alter=3:telly=0
  28.     a$=ch$:GOSUB Modem:ch$=""
  29.   WEND
  30.   ch$=INKEY$:i$=i$+ch$
  31.   a$=ch$:GOSUB Modem
  32.   IF ch$=CHR$(10) OR ch$=CHR$(13) OR ch$=r$ THEN telly=0:GOTO MoreAnswers
  33.   IF ch$=CHR$(8) AND LEN(i$)>=2 THEN i$=LEFT$(i$,LEN(i$)-2)
  34.   ch$="":IF LEN(i$)=0 THEN connect=PEEK (&Hbfd*&H1000+&H0):IF connect<>0 THEN okp=0:RETURN
  35. WEND
  36. IF i$<>"" THEN MoreAnswers
  37. SomeAnswers:
  38. ch$=INKEY$:i$=i$+ch$:a$=ch$:GOSUB Modem
  39. IF ch$= CHR$(10) OR ch$=CHR$(13) OR ch$=r$ THEN MoreAnswers
  40. IF ch$=CHR$(8) AND LEN(i$)>=2 THEN i$=LEFT$(i$,LEN(i$)-2)
  41. ch$=""
  42. GOTO SomeAnswers
  43. MoreAnswers:
  44. IF okp<>1 THEN RETURN
  45. IF i$="" THEN ch$="":GOTO Answers
  46. t$=i$:IF LEN(t$)>80 THEN t$=LEFT$(t$,78)+r$
  47. RETURN
  48.  
  49. SeqRead:
  50. ERASE ABCS$:DIM ABCS$(185)
  51. a$=r$+r$+"[>                                K Quits                               <]"+r$+r$:GOSUB Modem
  52. OPEN "I", #3, file$
  53. ReadSeq:
  54. j=0:L=0:k=0:Countl=0
  55. WHILE NOT EOF(3)
  56.   x=FRE(0):j=j+1
  57.   LINE INPUT#3,ABCS$(j):ABCS$(j)=ABCS$(j)+r$
  58. WEND
  59. CLOSE#3:k=j:L=0:Detect=0
  60. WHILE L<k
  61.   L=L+1:a$=ABCS$(L):GOSUB Modem
  62.   CheckSeq:
  63.   t$="":t=0:i$="":ch$="":IF rings=0 THEN SomeCheckSeq
  64.   WHILE LOC(1)<>0
  65.     ch$=INPUT$(1,1):equivs=ASC(ch$) AND 127:IF equivs<>1 THEN ch$=CHR$(equivs)
  66.     i$=i$+ch$:equivs=0:a$=ch$:GOSUB Modem
  67.   WEND
  68.   IF i$<>"" THEN MoreCheckSeq
  69.   SomeCheckSeq:
  70.   ch$=INKEY$:i$=i$+ch$:a$=ch$:GOSUB Modem
  71.   OtherCheckSeq:
  72.   IF Detect=1 GOTO MoreCheckSeq
  73.   Countl=Countl+1:IF Countl=24 THEN a$=r$+"More (y,n,c)?":GOSUB A1
  74.   IF Countl=24 THEN MenS$=UCASE$(LEFT$(t$,1)):IF MenS$="N" THEN L=k+1
  75.   IF Countl=24 AND MenS$="Y" THEN Countl=0
  76.   IF Countl=24 AND MenS$="C" THEN Detect=1
  77.   IF Countl=24 AND Detect<>1 THEN Countl=0
  78.   MoreCheckSeq:
  79.   IF i$=CHR$(75) OR i$=CHR$(107) THEN L=k+1
  80. WEND
  81. RETURN
  82.  
  83. A1:
  84. GOSUB Modem:GOSUB Answers:RETURN
  85.  
  86. Mail:
  87. IF okp<>1 THEN RETURN
  88. GOSUB CheckConTime:IF okp<>1 THEN RETURN
  89. a$=r$+"Mail:":GOSUB A1:MenS$=UCASE$(LEFT$(t$,1))
  90. IF MenS$="S" THEN MailScan
  91. IF MenS$="R" THEN MailRead
  92. IF MenS$="P" THEN Acd=0:GOSUB PostMail:GOTO Mail
  93. IF MenS$="?" THEN file$="df1:mails/mailmenu":GOSUB SeqRead:GOTO Mail
  94. IF MenS$="X" THEN RETURN
  95. a$=r$+"No such command.":GOSUB Modem:GOTO Mail
  96. MailScan:
  97. IF eM=0 THEN a$=r$+"You don't have any mail.":GOSUB Modem:GOTO Mail
  98. file$=Name1$+Name2$:GOSUB SpaceDelete
  99. IF Email$(1)="1" THEN OPEN "I",#3,"df1:mails/"+file$+"1":FOR j=1 TO 2:LINE INPUT#3, ABCS$(j):NEXT j:CLOSE#3:a$=r$+ABCS$(1)+r$+ABCS$(2)+r$+r$:GOSUB Modem
  100. IF Email$(2)="1" THEN OPEN "I",#3,"df1:mails/"+file$+"2":FOR j=1 TO 2:LINE INPUT#3, ABCS$(j):NEXT j:CLOSE#3:a$=r$+ABCS$(1)+r$+ABCS$(2)+r$+r$:GOSUB Modem
  101. IF Email$(3)="1" THEN OPEN "I",#3,"df1:mails/"+file$+"3":FOR j=1 TO 2:LINE INPUT#3, ABCS$(j):NEXT j:CLOSE#3:a$=r$+ABCS$(1)+r$+ABCS$(2)+r$+r$:GOSUB Modem
  102. IF Email$(4)="1" THEN OPEN "I",#3,"df1:mails/"+file$+"4":FOR j=1 TO 2:LINE INPUT#3, ABCS$(j):NEXT j:CLOSE#3:a$=r$+ABCS$(1)+r$+ABCS$(2)+r$+r$:GOSUB Modem
  103. IF Email$(5)="1" THEN OPEN "I",#3,"df1:mails/"+file$+"5":FOR j=1 TO 2:LINE INPUT#3, ABCS$(j):NEXT j:CLOSE#3:a$=r$+ABCS$(1)+r$+ABCS$(2)+r$+r$:GOSUB Modem
  104. CLOSE#3:GOTO Mail
  105. MailRead:
  106. IF eM=0 THEN a$=r$+"You don't have any mail.":GOSUB Modem:GOTO Mail
  107. IF Email$(1)="1" THEN file$="df1:mails/"+Name1$+" "+Name2$+"1":lab=1:GOSUB SpaceDelete:GOSUB SeqRead:mfile$=file$:GOSUB MoreMailRead
  108. IF Email$(2)="1" THEN file$="df1:mails/"+Name1$+" "+Name2$+"2":lab=2:GOSUB SpaceDelete:GOSUB SeqRead:mfile$=file$:GOSUB MoreMailRead
  109. IF Email$(3)="1" THEN file$="df1:mails/"+Name1$+" "+Name2$+"3":lab=3:GOSUB SpaceDelete:GOSUB SeqRead:mfile$=file$:GOSUB MoreMailRead
  110. IF Email$(4)="1" THEN file$="df1:mails/"+Name1$+" "+Name2$+"4":lab=4:GOSUB SpaceDelete:GOSUB SeqRead:mfile$=file$:GOSUB MoreMailRead
  111. IF Email$(5)="1" THEN file$="df1:mails/"+Name1$+" "+Name2$+"5":lab=5:GOSUB SpaceDelete:GOSUB SeqRead:mfile$=file$:GOSUB MoreMailRead
  112. a$=r$+"No More Mail.":GOSUB Modem:GOTO ExitMailRead
  113. MoreMailRead:
  114. a$=r$+"[R]eply   [D]elete   [N]ext   e[X]it   :":GOSUB A1
  115. MenS$=UCASE$(LEFT$(t$,1))
  116. IF MenS$="D" THEN KILL mfile$:KILL mfile$+".info":eM=eM-1:Email$(lab)="0":GOTO MailRead
  117. IF MenS$="X" THEN ExitMailRead
  118. IF MenS$="N" THEN RETURN
  119. IF MenS$="R" THEN Acd=1:GOSUB PostMail:GOTO MoreMailRead
  120. GOTO MoreMailRead
  121.  
  122. PostMail:
  123. IF Acd=1 THEN file$=ABCS$(2):GOSUB OtherSpaceDelete:RecipID$=file$:RecipID=VAL(RecipID$):GOTO MorePostMail
  124. a$=r$+"Send to Whom?":GOSUB A1:Recip$=UCASE$(LEFT$(t$,LEN(t$)-1)):Recip$=Recip$+"="
  125. IF LEN(Recip$)>25 THEN Recip$=LEFT$(Recip$,25)
  126. RecipnaMe=LEN(Recip$)
  127. Ddt=0:Dch=0
  128. WHILE Ddt<1
  129.   Dch=Dch+1:uil$=STR$(Dch):uil$=RIGHT$(uil$,1)
  130.   OPEN "I",#3,"df1:Storehouse"+uil$
  131.   Dxq=0:Lmn=0:Dab=0
  132.   WHILE NOT EOF(3)
  133.     Dxq=Dxq+1
  134.     LINE INPUT#3, ABCS$(Dxq)
  135.   WEND
  136.   Dzz=0
  137.   WHILE Lmn<1
  138.     Dzz=Dzz+1
  139.     IF Recip$=LEFT$(ABCS$(Dzz),RecipnaMe) THEN Lmn=5:Dab=Dzz
  140.     IF Dzz=Dxq AND Lmn<>5 THEN Lmn=2
  141.   WEND
  142.   IF Lmn=5 THEN Ddt=5:RecipID$=RIGHT$(ABCS$(Dab),LEN(ABCS$(Dab))-RecipnaMe)
  143.   IF Lmn=2 AND Dch=6 THEN Ddt=3
  144.   CLOSE#3
  145. WEND
  146. IF Ddt=3 THEN a$=r$+"No Such User!":GOSUB Modem:RETURN
  147. RecipID=VAL(RecipID$)
  148. a$=r$+"Subject:":GOSUB A1:Subject$=UCASE$(LEFT$(t$,LEN(t$)-1))
  149. IF LEN(Subject$)>30 THEN Subject$=LEFT$(Subject$,30)
  150. ABCS$(1)="Time:"+TIME$+" "+"Date:"+DATE$
  151. Recip$=LEFT$(Recip$,LEN(Recip$)-1)
  152. ABCS$(2)="Name:"+Name1$+" "+Name2$+" Subject:"+Subject$+" ID:"+UserID$
  153. MorePostMail:
  154. IF Acd=1 THEN ABCS$(1)="Time:"+TIME$+" "+"Date:"+DATE$
  155. CLOSE#4:OPEN "R", #4, "df1:USER",120
  156. FIELD #4, 1 AS check$,9 AS N1$,15 AS N2$,10 AS Co$,15 AS Adr$,10 AS CI$,10 AS STA$,3 AS AG$,9 AS PAS$,3 AS B1$,3 AS B2$,3 AS B3$,3 AS B4$,3 AS B5$,3 AS B6$,3 AS B7$,3 AS B8$,3 AS B9$,1 AS EM1$,1 AS EM2$,1 AS EM3$,1 AS EM4$,1 AS EM5$,3 AS Valu$
  157. FIELD #4, 117 AS dump$,1 AS VTE1$,1 AS VTE2$,1 AS VTE3$
  158. GET#4,RecipID:lab=0:Ddt=0
  159. IF Acd=1 THEN Recip$=N1$+" "+N2$
  160. IF Acd=1 THEN ABCS$(2)="Name:"+Name1$+" "+Name2$+" Subject:Reply  ID:"+UserID$ 
  161. IF EM1$="0" THEN lab=1:GOTO PostMoreMail
  162. IF EM2$="0" THEN lab=2:GOTO PostMoreMail
  163. IF EM3$="0" THEN lab=3:GOTO PostMoreMail
  164. IF EM4$="0" THEN lab=4:GOTO PostMoreMail
  165. IF EM5$="0" THEN lab=5:GOTO PostMoreMail
  166. a$=r$+"Sorry "+Recip$+"'s Mailbox is full.":GOSUB Modem:CLOSE#4:RETURN
  167. PostMoreMail:
  168. ABCS$(3)=r$
  169. a$=r$+"Enter Message: [Max. 40 lines] /EX to exit"+r$:GOSUB Modem
  170. Extm=0:Ddt=3
  171. WHILE Extm<1
  172.   Ddt=Ddt+1
  173.   a$=r$+STR$(Ddt-3)+":":GOSUB A1
  174.   ABCS$(Ddt)=t$
  175.   IF UCASE$(LEFT$(t$,3))="/EX" THEN Extm=1:Ddt=Ddt-1
  176.   IF Ddt=42 THEN a$=r$+"Last Line!":GOSUB Modem
  177.   IF Ddt=43 THEN Extm=1
  178. WEND
  179. QueryPostMail:
  180. a$=r$+"S- Save  L- List  A- Abort  R- Replace  D- Delete  I- Insert  C- Continue :":GOSUB A1
  181. MenS$=UCASE$(LEFT$(t$,1))
  182. IF MenS$="S" THEN SavePostMail
  183. IF MenS$="L" THEN ListPostMail
  184. IF MenS$="A" THEN CLOSE#2:CLOSE#4:RETURN
  185. IF MenS$="R" THEN EditPostMail
  186. IF MenS$="D" THEN DeletePostMail
  187. IF MenS$="I" THEN InsertPostMail
  188. IF MenS$="C" THEN ContinuePostMail
  189. GOTO QueryPostMail
  190. SavePostMail:
  191. Recip$=Recip$+RIGHT$(STR$(lab),1):file$=Recip$:GOSUB SpaceDelete
  192. Recip$=file$
  193. OPEN "O",#3,"Df1:mails/"+Recip$
  194. FOR j=1 TO Ddt
  195. PRINT#3,ABCS$(j)
  196. NEXT j:CLOSE#3:Acd=0
  197. IF lab=1 THEN LSET EM1$="1":PUT#4,RecipID:CLOSE#4:RETURN
  198. IF lab=2 THEN LSET EM2$="1":PUT#4,RecipID:CLOSE#4:RETURN
  199. IF lab=3 THEN LSET EM3$="1":PUT#4,RecipID:CLOSE#4:RETURN
  200. IF lab=4 THEN LSET EM4$="1":PUT#4,RecipID:CLOSE#4:RETURN
  201. IF lab=5 THEN LSET EM5$="1":PUT#4,RecipID:CLOSE#4:RETURN
  202. ListPostMail:
  203. a$=r$+"Starting Line No.:":GOSUB A1:t$=LEFT$(t$,2):stln=VAL(t$)+3:IF stln<3 OR stln>Ddt THEN ListPostMail
  204. a$=r$+"Ending Line No.:":GOSUB A1:t$=LEFT$(t$,2):Eln=VAL(t$)+3:IF Eln<stln THEN ListPostMail
  205. IF Eln>Ddt THEN Eln=Ddt
  206. FOR L=stln TO Eln
  207. a$=STR$(L-3)+":"+ABCS$(L):GOSUB Modem
  208. NEXT L
  209. GOTO QueryPostMail
  210. EditPostMail:
  211. a$=r$+"Line Number to Replace:":GOSUB A1:t$=LEFT$(t$,2):Rln=VAL(t$)+3:IF Rln<4 OR Rln>Ddt THEN EditPostMail
  212. a$=r$+"Replace:"+r$+ABCS$(Rln)+r$+"With:"+r$+":":GOSUB A1
  213. IF t$=CHR$(10) OR t$=CHR$(13) OR t$=r$ THEN a$=r$+"Edit Aborted.":GOSUB Modem:GOTO QueryPostMail
  214. ABCS$(44)=t$
  215. a$=r$+"Replace:"+r$+ABCS$(Rln)+r$+"With:"+r$+ABCS$(44)+r$+"(Y or N):":GOSUB A1:MenS$=UCASE$(LEFT$(t$,1))
  216. IF MenS$="N" THEN QueryPostMail
  217. IF MenS$="Y" THEN ABCS$(Rln)=ABCS$(44):GOTO QueryPostMail
  218. ExitMailRead:
  219. CLOSE#2:OPEN "R", #2, "df1:USER",120
  220. FIELD #2, 1 AS check$,9 AS N1$,15 AS N2$,10 AS Co$,15 AS Adr$,10 AS CI$,10 AS STA$,3 AS AG$,9 AS PAS$,3 AS B1$,3 AS B2$,3 AS B3$,3 AS B4$,3 AS B5$,3 AS B6$,3 AS B7$,3 AS B8$,3 AS B9$,1 AS EM1$,1 AS EM2$,1 AS EM3$,1 AS EM4$,1 AS EM5$,3 AS Valu$
  221. FIELD #2, 117 AS dump$,1 AS VTE1$,1 AS VTE2$,1 AS VTE3$
  222. GET#2,UserID
  223. LSET EM1$=Email1$
  224. LSET EM2$=Email2$
  225. LSET EM3$=Email3$
  226. LSET EM4$=Email4$
  227. LSET EM5$=Email5$
  228. PUT#2,UserID
  229. CLOSE#2:GOTO Mail
  230.  
  231. CheckConTime:
  232. ContiMe$=TIME$:ChEntTime$=RIGHT$(EnttiMe$,5):ContiMe$=RIGHT$(ContiMe$,5)
  233. ContiMe=VAL(ContiMe$):EnttiMe=VAL(ChEntTime$)
  234. IF ContiMe-EnttiMe>30 AND Veru$="000" THEN okp=0:a$=r$+"Time limit exceeded."+r$:GOSUB Modem:RETURN
  235. IF ContiMe-EnttiMe>45 AND Veru$="007" THEN okp=0:a$=r$+"Time limit exceeded."+r$:GOSUB Modem:RETURN
  236. okp=1:RETURN
  237.  
  238. InsertPostMail:
  239. IF Ddt>=199 THEN a$=r$+"No room to insert.":GOSUB Modem:GOTO QueryPostMail
  240. a$=r$+"Insert before which line:":GOSUB A1:IF t$=CHR$(10) OR t$=CHR$(13) THEN QueryPostMail
  241. instln=VAL(t$)+3
  242. FOR j=Ddt TO instln STEP -1
  243. ABCS$(j+1)=ABCS$(j)
  244. NEXT j
  245. ABCS$(instln)="    "+r$:Ddt=Ddt+1
  246. GOTO QueryPostMail
  247.  
  248. DeletePostMail:
  249. a$=r$+"Delete starting which line:":GOSUB A1:IF t$=CHR$(10) OR t$=CHR$(13) THEN QueryPostMail
  250. stln=VAL(t$)+3:IF stln<4 OR stln>Ddt THEN QueryPostMail
  251. a$=r$+"Ending which line:":GOSUB A1:endtln=VAL(t$)+3:IF endtln>Ddt THEN endtln=Ddt
  252. IF stln>endtln THEN elsie=stln:stln=endtln:endtln=elsie
  253. a$=r$+"Delete from"+STR$(stln-3)+" to"+STR$(endtln-3)+r$+"Are you sure? (Y or N):":GOSUB A1:MenS$=UCASE$(LEFT$(t$,1))
  254. IF MenS$="N" THEN QueryPostMail
  255. FOR j=endtln+1 TO Ddt
  256. ABCS$(j-((endtln+1)-stln))=ABCS$(j)
  257. NEXT j
  258. Ddt=Ddt-((endtln+1)-stln)
  259. FOR j=Ddt TO Ddt+((endtln+1)-stln)
  260. ABCS$(j)="    "+r$
  261. NEXT j
  262. GOTO QueryPostMail
  263.  
  264. ContinuePostMail:
  265. IF Ddt>198 THEN a$=r$+"No Room!":GOTO QueryPostMail
  266. Dzz=0
  267. a$=r$+"Enter Text: [Max. 197 lines] /EX to Exit":GOSUB Modem
  268. WHILE Dzz<1
  269.   Ddt=Ddt+1
  270.   a$=r$+STR$(Ddt-3)+":":GOSUB A1:ABCS$(Ddt)=t$
  271.   IF UCASE$(LEFT$(t$,3))="/EX" THEN Dzz=1:Ddt=Ddt-1
  272.   IF Ddt=199 THEN a$=r$+"Last Line!":GOSUB Modem
  273.   IF Ddt=200 THEN Dzz=1
  274. WEND
  275. GOTO QueryPostMail
  276.  
  277. SpaceDelete:
  278. x$=file$:tfile$=""
  279. FOR j= 1 TO LEN(x$):p$=MID$(x$,j,1)
  280. ght=ASC(p$+CHR$(1))
  281. tfile$=tfile$+CHR$(ght)
  282. IF ght<2 OR ght=32 THEN tfile$=LEFT$(tfile$,LEN(tfile$)-1)
  283. NEXT j
  284. file$=tfile$
  285. RETURN
  286.  
  287. OtherSpaceDelete:
  288. x$=RIGHT$(file$,4):tfile$=""
  289. FOR j= 1 TO LEN(x$):p$=MID$(x$,j,1)
  290. ght=ASC(p$+CHR$(1))
  291. tfile$=tfile$+CHR$(ght)
  292. IF ght<48 OR ght>57 THEN tfile$=LEFT$(tfile$,LEN(tfile$)-1)
  293. NEXT j
  294. file$=tfile$
  295. RETURN
  296.  
  297.